home *** CD-ROM | disk | FTP | other *** search
- /* Output like sprintf to a buffer of specified size.
- Also takes args differently: pass one pointer to an array of strings
- in addition to the format string which is separate.
- Copyright (C) 1995 Amdahl Corporation.
- Rewritten by mly to use varargs.h.
- Rewritten from scratch by Ben Wing (February 1995) for Mule; expanded
- to full printf spec.
-
- This file is part of XEmacs.
-
- XEmacs is free software; you can redistribute it and/or modify it
- under the terms of the GNU General Public License as published by the
- Free Software Foundation; either version 2, or (at your option) any
- later version.
-
- XEmacs is distributed in the hope that it will be useful, but WITHOUT
- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
- for more details.
-
- You should have received a copy of the GNU General Public License
- along with XEmacs; see the file COPYING. If not, write to the Free
- Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
-
- /* Synched up with: Mule 2.0, FSF 19.28. */
-
- #include <config.h>
- #include "lisp.h"
-
- #include "buffer.h"
- #include "lstream.h"
-
- static char *valid_flags = "-+ #0";
-
- static char *valid_converters = "diouxXfeEgGcsS";
- static char *int_converters = "dic";
- static char *unsigned_int_converters = "ouxX";
- static char *double_converters = "feEgG";
- static char *string_converters = "sS";
-
- struct printf_spec
- {
- int argnum; /* which argument does this spec want? This is one-based:
- The first argument given is numbered 1, the second
- is 2, etc. This is to handle %##$x-type specs. */
- int minwidth;
- int precision;
- int minus_flag:1;
- int plus_flag:1;
- int space_flag:1;
- int number_flag:1;
- int zero_flag:1;
- int h_flag:1;
- int l_flag:1;
- char converter; /* converter character or 0 for dummy marker
- indicating literal text at the end of the
- specification */
- Bytecount text_before; /* position of the first character of the
- block of literal text before this spec */
- Bytecount text_before_len; /* length of that text */
- };
-
- union printf_arg
- {
- int i;
- unsigned int ui;
- long l;
- unsigned long ul;
- double d;
- Bufbyte *bp;
- };
-
- /* We maintain a list of all the % specs in the specification,
- along with the offset and length of the block of literal text
- before each spec. In addition, we have a "dummy" spec that
- represents all the literal text at the end of the specification.
- Its converter is 0. */
-
- typedef struct
- {
- Dynarr_declare (struct printf_spec);
- } printf_spec_dynarr;
-
- typedef struct
- {
- Dynarr_declare (union printf_arg);
- } printf_arg_dynarr;
-
- /* Append STRING (of length LEN) to STREAM. MINLEN is the minimum field
- width. If MINUS_FLAG is set, left-justify the string in its field;
- otherwise, right-justify. If ZERO_FLAG is set, pad with 0's; otherwise
- pad with spaces.
-
- Note that MINLEN is a Charcount but LEN is a Bytecount. */
-
- static void
- doprnt_1 (Lisp_Object stream, CONST Bufbyte *string, Bytecount len,
- Charcount minlen, int minus_flag, int zero_flag)
- {
- Charcount cclen;
- Bufbyte pad;
- Lstream *lstr = XLSTREAM (stream);
-
- cclen = bytecount_to_charcount (string, len);
-
- if (zero_flag)
- pad = '0';
- else
- pad = ' ';
-
- /* Padding at beginning to right-justify ... */
- if (minlen > cclen && !minus_flag)
- {
- int to_add = minlen - cclen;
- while (to_add > 0)
- {
- Lstream_putc (lstr, pad);
- to_add--;
- }
- }
-
- {
- /* Simply truncating LEN to the size of the buffer might result in a
- partial character being copied, which is bad bad bad. So we use
- VALIDATE_CHARPTR_BACKWARD to avoid this. */
- CONST Bufbyte *strend = string + len;
- VALIDATE_CHARPTR_BACKWARD (strend);
- len = strend - string;
- }
- Lstream_write (lstr, string, len);
-
- /* Padding at end to left-justify ... */
- if (minlen > cclen && minus_flag)
- {
- int to_add = minlen - cclen;
- while (to_add > 0)
- {
- Lstream_putc (lstr, pad);
- to_add--;
- }
- }
- }
-
- static CONST Bufbyte *
- parse_off_posnum (CONST Bufbyte *start, CONST Bufbyte *end, int *returned_num)
- {
- Bufbyte arg_convert[100];
- REGISTER Bufbyte *arg_ptr = arg_convert;
-
- *returned_num = -1;
- while (start != end && isdigit (*start))
- {
- if (arg_ptr - arg_convert >= sizeof (arg_convert) - 1)
- error ("Format converter number too large");
- *arg_ptr++ = *start++;
- }
- *arg_ptr = '\0';
- if (arg_convert != arg_ptr)
- *returned_num = atoi ((char *) arg_convert);
- return start;
- }
-
- #define NEXT_ASCII_BYTE(ch) \
- do { \
- if (fmt == fmt_end) \
- error ("Premature end of format string"); \
- ch = *fmt; \
- if (ch >= 0200) \
- error ("Non-ASCII character in format converter spec"); \
- fmt++; \
- } while (0)
-
- static printf_spec_dynarr *
- parse_doprnt_spec (CONST Bufbyte *format, Bytecount format_length)
- {
- CONST Bufbyte *fmt = format;
- CONST Bufbyte *fmt_end = format + format_length;
- printf_spec_dynarr *specs = Dynarr_new (struct printf_spec);
- int prev_argnum = 0;
-
- while (1)
- {
- struct printf_spec spec;
- CONST Bufbyte *text_end;
- Bufbyte ch;
-
- memset (&spec, 0, sizeof (spec));
- if (fmt == fmt_end)
- return specs;
- text_end = (Bufbyte *) memchr (fmt, '%', fmt_end - fmt);
- if (!text_end)
- text_end = fmt_end;
- spec.text_before = fmt - format;
- spec.text_before_len = text_end - fmt;
- fmt = text_end;
- if (fmt != fmt_end)
- {
- fmt++; /* skip over % */
-
- /* A % is special -- no arg number. According to ANSI specs,
- field width does not apply to %% conversion. */
- if (fmt != fmt_end && *fmt == '%')
- {
- spec.converter = '%';
- Dynarr_add (specs, spec);
- fmt++;
- continue;
- }
-
- /* Is there a field number specifier? */
- {
- CONST Bufbyte *ptr;
- int fieldspec;
-
- ptr = parse_off_posnum (fmt, fmt_end, &fieldspec);
- if (fieldspec > 0 && ptr != fmt_end && *ptr == '$')
- {
- /* There is a format specifier */
- prev_argnum = fieldspec;
- fmt = ptr + 1;
- }
- else
- prev_argnum++;
- spec.argnum = prev_argnum;
- }
-
- /* Parse off any flags */
- NEXT_ASCII_BYTE (ch);
- while (strchr (valid_flags, ch))
- {
- switch (ch)
- {
- case '-': spec.minus_flag = 1; break;
- case '+': spec.plus_flag = 1; break;
- case ' ': spec.space_flag = 1; break;
- case '#': spec.number_flag = 1; break;
- case '0': spec.zero_flag = 1; break;
- default: abort ();
- }
- NEXT_ASCII_BYTE (ch);
- }
-
- /* Parse off the minimum field width */
- fmt--; /* back up */
- fmt = parse_off_posnum (fmt, fmt_end, &spec.minwidth);
- if (spec.minwidth == -1)
- spec.minwidth = 0;
-
- /* Parse off any precision specified */
- NEXT_ASCII_BYTE (ch);
- if (ch == '.')
- {
- fmt = parse_off_posnum (fmt, fmt_end, &spec.precision);
- if (spec.precision == -1)
- spec.precision = 0;
- NEXT_ASCII_BYTE (ch);
- }
- else
- /* No precision specified */
- spec.precision = -1;
-
- /* Parse off h or l flag */
- if (ch == 'h' || ch == 'l')
- {
- if (ch == 'h')
- spec.h_flag = 1;
- else
- spec.l_flag = 1;
- NEXT_ASCII_BYTE (ch);
- }
-
- if (!strchr (valid_converters, ch))
- error ("Invalid converter character %c", ch);
- spec.converter = ch;
- }
-
- if (spec.space_flag && spec.plus_flag)
- spec.space_flag = 0;
- if (spec.zero_flag && spec.space_flag)
- spec.zero_flag = 0;
-
- Dynarr_add (specs, spec);
- }
-
- return specs; /* suppress compiler warning */
- }
-
- static int
- get_args_needed (printf_spec_dynarr *specs)
- {
- int args_needed = 0;
- REGISTER int i;
-
- /* Figure out how many args are needed. This may be less than
- the number of specs because a spec could be %% or could be
- missing (literal text at end of format string) or there
- could be specs where the field number is explicitly given.
- We just look for the maximum argument number that's referenced. */
-
- for (i = 0; i < Dynarr_length (specs); i++)
- {
- char ch = Dynarr_at (specs, i).converter;
- if (ch && ch != '%')
- {
- int argnum = Dynarr_at (specs, i).argnum;
- if (argnum > args_needed)
- args_needed = argnum;
- }
- }
-
- return args_needed;
- }
-
- static printf_arg_dynarr *
- get_doprnt_args (printf_spec_dynarr *specs, va_list vargs)
- {
- printf_arg_dynarr *args = Dynarr_new (union printf_arg);
- union printf_arg arg;
- REGISTER int i;
- int args_needed = get_args_needed (specs);
-
- memset (&arg, 0, sizeof (union printf_arg));
- for (i = 1; i <= args_needed; i++)
- {
- int j;
- char ch;
- struct printf_spec *spec = 0;
-
- for (j = 0; j < Dynarr_length (specs); j++)
- {
- spec = Dynarr_atp (specs, j);
- if (spec->argnum == i)
- break;
- }
-
- if (j == Dynarr_length (specs))
- error ("No conversion spec for argument %d", i);
-
- ch = spec->converter;
-
- /* int even if ch == 'c': "the type used in va_arg is supposed to
- match the actual type **after default promotions**." */
-
- if (strchr (int_converters, ch))
- {
- if (spec->h_flag)
- arg.i = va_arg (vargs, short);
- else if (spec->l_flag)
- arg.l = va_arg (vargs, long);
- else
- arg.i = va_arg (vargs, int);
- }
- else if (strchr (unsigned_int_converters, ch))
- {
- if (spec->h_flag)
- arg.ui = va_arg (vargs, unsigned short);
- else if (spec->l_flag)
- arg.ul = va_arg (vargs, unsigned long);
- else
- arg.ui = va_arg (vargs, unsigned int);
- }
- else if (strchr (double_converters, ch))
- arg.d = va_arg (vargs, double);
- else if (strchr (string_converters, ch))
- arg.bp = va_arg (vargs, Bufbyte *);
- else abort ();
-
- Dynarr_add (args, arg);
- }
-
- return args;
- }
-
- /* Generate output from a format-spec FORMAT, of length FORMAT_LENGTH.
- Output goes in BUFFER, which has room for BUFSIZE bytes.
- If the output does not fit, truncate it to fit.
- Returns the number of bytes stored into BUFFER.
- LARGS or VARGS points to the arguments, and NARGS says how many.
- if LARGS is non-zero, it should be a pointer to NARGS worth of
- Lisp arguments. Otherwise, VARGS should be a va_list referring
- to the arguments. */
-
- static Bytecount
- emacs_doprnt_1 (Lisp_Object stream, CONST Bufbyte *format_nonreloc,
- Lisp_Object format_reloc, Bytecount format_length,
- int nargs,
- /* #### Gag me, gag me, gag me */
- CONST Lisp_Object *largs, va_list vargs)
- {
- printf_spec_dynarr *specs = 0;
- printf_arg_dynarr *args = 0;
- REGISTER int i;
- int init_byte_count = Lstream_byte_count (XLSTREAM (stream));
-
- if (!NILP (format_reloc))
- {
- format_nonreloc = string_data (XSTRING (format_reloc));
- format_length = string_length (XSTRING (format_reloc));
- }
- if (format_length < 0)
- format_length = (Bytecount) strlen ((char *) format_nonreloc);
-
- specs = parse_doprnt_spec (format_nonreloc, format_length);
- if (largs)
- {
- /* allow too many args for string, but not too few */
- if (nargs < get_args_needed (specs))
- signal_error (Qwrong_number_of_arguments,
- list3 (Qformat,
- make_number (nargs),
- !NILP (format_reloc) ? format_reloc :
- make_string (format_nonreloc, format_length)));
- }
- else
- {
- args = get_doprnt_args (specs, vargs);
- }
-
- for (i = 0; i < Dynarr_length (specs); i++)
- {
- struct printf_spec *spec = Dynarr_atp (specs, i);
- char ch;
-
- /* Copy the text before */
- if (!NILP (format_reloc)) /* refetch in case of GC below */
- format_nonreloc = string_data (XSTRING (format_reloc));
- doprnt_1 (stream, format_nonreloc + spec->text_before,
- spec->text_before_len, 0, 0, 0);
-
- ch = spec->converter;
-
- if (!ch)
- continue;
-
- if (ch == '%')
- {
- doprnt_1 (stream, (Bufbyte *) &ch, 1, 0, 0, 0);
- continue;
- }
-
- if (largs && (spec->argnum < 1 || spec->argnum > nargs))
- error ("Invalid repositioning argument %d", spec->argnum);
-
- else if (ch == 'S' || ch == 's')
- {
- Bufbyte *string;
- Bytecount string_len;
-
- if (!largs)
- {
- string = Dynarr_at (args, spec->argnum - 1).bp;
- string_len = strlen ((char *) string);
- }
- else
- {
- Lisp_Object obj = largs[spec->argnum - 1];
- struct Lisp_String *ls;
-
- if (ch == 'S')
- {
- /* For `S', prin1 the argument and then treat like
- a string. */
- ls = XSTRING (Fprin1_to_string (obj, Qnil));
- }
- else if (STRINGP (obj))
- ls = XSTRING (obj);
- else if (SYMBOLP (obj))
- ls = XSYMBOL (obj)->name;
- else
- {
- /* convert to string using princ. */
- ls = XSTRING (Fprin1_to_string (obj, Qt));
- }
- string = string_data (ls);
- string_len = string_length (ls);
- }
-
- if (spec->precision >= 0)
- string_len = min (string_len, spec->precision);
- doprnt_1 (stream, string, string_len, spec->minwidth,
- spec->minus_flag, spec->zero_flag);
- }
-
- else
- {
- /* Must be a number. */
- union printf_arg arg;
-
- if (!largs)
- {
- arg = Dynarr_at (args, spec->argnum - 1);
- }
- else
- {
- Lisp_Object obj = largs[spec->argnum - 1];
- if (!INT_OR_FLOATP (obj))
- {
- error ("format specifier %%%c doesn't match argument type",
- ch);
- }
- else if (strchr (double_converters, ch))
- arg.d = XFLOATINT (obj);
- else
- {
- int val;
-
- if (FLOATP (obj))
- val = XINT (Ftruncate (obj));
- else
- val = XINT (obj);
- if (strchr (unsigned_int_converters, ch))
- {
- if (spec->l_flag)
- arg.ul = (unsigned long) val;
- else
- arg.ui = (unsigned int) val;
- }
- else
- {
- if (spec->l_flag)
- arg.l = (long) val;
- else
- arg.i = val;
- }
- }
- }
-
-
- if (ch == 'c')
- {
- Emchar a;
- Bytecount charlen;
- Bufbyte charbuf[MAX_EMCHAR_LEN];
-
- if (spec->l_flag)
- a = (Emchar) arg.l;
- else
- a = (Emchar) arg.i;
-
- if (!valid_char_p (a))
- error ("invalid character value %d to %%c spec", a);
-
- charlen = emchar_to_charptr (a, charbuf);
- doprnt_1 (stream, charbuf, charlen, spec->minwidth,
- spec->minus_flag, spec->zero_flag);
- }
-
- else
- {
- char text_to_print[500];
- char constructed_spec[100];
-
- /* Partially reconstruct the spec and use sprintf() to
- format the string. */
-
- /* Make sure nothing stupid happens */
- /* DO NOT REMOVE THE (int) CAST! Incorrect results will
- follow! */
- spec->precision = min (spec->precision,
- (int) (sizeof (text_to_print) - 50));
-
- constructed_spec[0] = 0;
- strcat (constructed_spec, "%");
- if (spec->plus_flag)
- strcat (constructed_spec, "+");
- if (spec->space_flag)
- strcat (constructed_spec, " ");
- if (spec->number_flag)
- strcat (constructed_spec, "#");
- if (spec->precision >= 0)
- {
- strcat (constructed_spec, ".");
- sprintf (constructed_spec + strlen (constructed_spec), "%d",
- spec->precision);
- }
- sprintf (constructed_spec + strlen (constructed_spec), "%c", ch);
-
- /* sprintf the mofo */
- /* we have to use separate calls to sprintf(), rather than
- a single big conditional, because of the different types
- of the arguments */
- if (strchr (double_converters, ch))
- sprintf (text_to_print, constructed_spec, arg.d);
- else if (strchr (unsigned_int_converters, ch))
- {
- if (spec->l_flag)
- sprintf (text_to_print, constructed_spec, arg.ul);
- else
- sprintf (text_to_print, constructed_spec, arg.ui);
- }
- else
- {
- if (spec->l_flag)
- sprintf (text_to_print, constructed_spec, arg.l);
- else
- sprintf (text_to_print, constructed_spec, arg.i);
- }
-
- doprnt_1 (stream, (Bufbyte *) text_to_print,
- strlen (text_to_print),
- spec->minwidth, spec->minus_flag, spec->zero_flag);
- }
- }
- }
-
- /* #### will not get freed if error */
- if (specs)
- Dynarr_free (specs);
- if (args)
- Dynarr_free (args);
- return Lstream_byte_count (XLSTREAM (stream)) - init_byte_count;
- }
-
- /* You really don't want to know why this is necessary... */
- static Bytecount
- emacs_doprnt_2 (Lisp_Object stream, CONST Bufbyte *format_nonreloc,
- Lisp_Object format_reloc, Bytecount format_length, int nargs,
- CONST Lisp_Object *largs, ...)
- {
- va_list vargs;
- Bytecount val;
- va_start (vargs, largs);
- val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
- format_length, nargs, largs, vargs);
- va_end (vargs);
- return val;
- }
-
- /*********************** external entry points ***********************/
-
- #ifdef I18N3
- /* A note about I18N3 translating: the format string should get
- translated, but not under all circumstances. When the format
- string is a Lisp string, what should happen is that Fformat()
- should format the untranslated args[0] and return that, and also
- call Fgettext() on args[0] and, if that is different, format it
- and store it in the `string-translatable' property of
- the returned string. See Fgettext(). */
- #endif
-
- /* Send formatted output to STREAM. The format string comes from
- either FORMAT_NONRELOC (of length FORMAT_LENGTH; -1 means use
- strlen() to determine the length) or from FORMAT_RELOC, which
- should be a Lisp string. Return the number of bytes written
- to the stream.
-
- DO NOT pass the data from a Lisp string as the FORMAT_NONRELOC
- parameter, because this function can cause GC. */
-
- Bytecount
- emacs_doprnt_c (Lisp_Object stream, CONST Bufbyte *format_nonreloc,
- Lisp_Object format_reloc, Bytecount format_length,
- ...)
- {
- int val;
- va_list vargs;
-
- va_start (vargs, format_length);
- val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
- format_length, 0, 0, vargs);
- va_end (vargs);
- return val;
- }
-
- /* Like emacs_doprnt_c but the args come in va_list format. */
-
- Bytecount
- emacs_doprnt_va (Lisp_Object stream, CONST Bufbyte *format_nonreloc,
- Lisp_Object format_reloc, Bytecount format_length,
- va_list vargs)
- {
- return emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
- format_length, 0, 0, vargs);
- }
-
- /* Like emacs_doprnt_c but the args are Lisp objects instead of
- C arguments. This causes somewhat different behavior from
- the above two functions (which should act like printf).
- See `format' for a description of this behavior. */
-
- Bytecount
- emacs_doprnt_lisp (Lisp_Object stream, CONST Bufbyte *format_nonreloc,
- Lisp_Object format_reloc, Bytecount format_length,
- int nargs, CONST Lisp_Object *largs)
- {
- return emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
- format_length, nargs, largs);
- }
-
- /* The following three functions work like the above three but
- return their output as a Lisp string instead of sending it
- to a stream. */
-
- Lisp_Object
- emacs_doprnt_string_c (CONST Bufbyte *format_nonreloc,
- Lisp_Object format_reloc, Bytecount format_length,
- ...)
- {
- va_list vargs;
- Lisp_Object obj;
- Lisp_Object stream = make_resizing_buffer_stream ();
- struct gcpro gcpro1;
-
- GCPRO1 (stream);
- va_start (vargs, format_length);
- emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
- format_length, 0, 0, vargs);
- va_end (vargs);
- Lstream_flush (XLSTREAM (stream));
- obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
- Lstream_byte_count (XLSTREAM (stream)));
- UNGCPRO;
- return obj;
- }
-
- Lisp_Object
- emacs_doprnt_string_va (CONST Bufbyte *format_nonreloc,
- Lisp_Object format_reloc, Bytecount format_length,
- va_list vargs)
- {
- /* I'm fairly sure that this function cannot actually GC.
- That can only happen when the arguments to emacs_doprnt_1() are
- Lisp objects rather than C args. */
- Lisp_Object obj;
- Lisp_Object stream = make_resizing_buffer_stream ();
- struct gcpro gcpro1;
-
- GCPRO1 (stream);
- emacs_doprnt_1 (stream, format_nonreloc, format_reloc,
- format_length, 0, 0, vargs);
- Lstream_flush (XLSTREAM (stream));
- obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
- Lstream_byte_count (XLSTREAM (stream)));
- UNGCPRO;
- return obj;
- }
-
- Lisp_Object
- emacs_doprnt_string_lisp (CONST Bufbyte *format_nonreloc,
- Lisp_Object format_reloc, Bytecount format_length,
- int nargs, CONST Lisp_Object *largs)
- {
- Lisp_Object obj;
- Lisp_Object stream = make_resizing_buffer_stream ();
- struct gcpro gcpro1;
-
- GCPRO1 (stream);
- emacs_doprnt_2 (stream, format_nonreloc, format_reloc,
- format_length, nargs, largs);
- Lstream_flush (XLSTREAM (stream));
- obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)),
- Lstream_byte_count (XLSTREAM (stream)));
- UNGCPRO;
- return obj;
- }
-